home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume8 / pcmail / part05 < prev    next >
Encoding:
Text File  |  1989-11-03  |  46.4 KB  |  1,148 lines

  1. Newsgroups: comp.sources.misc
  2. subject: v08i113: pcmail part 05 of 08
  3. From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
  4. Reply-To: markl@oracle.com (Croaker the Physician)
  5.  
  6. Posting-number: Volume 8, Issue 113
  7. Submitted-by: markl@oracle.com (Croaker the Physician)
  8. Archive-name: pcmail/part05
  9.  
  10. #--------------------------------CUT HERE-------------------------------------
  11. #! /bin/sh
  12. #
  13. # This is a shell archive.  Save this into a file, edit it
  14. # and delete all lines above this comment.  Then give this
  15. # file to sh by executing the command "sh file".  The files
  16. # will be extracted into the current directory owned by
  17. # you with default permissions.
  18. #
  19. # The files contained herein are:
  20. #
  21. # -rw-rw-r--  1 markl        4075 Oct 31 11:53 pcmailedit.el
  22. # -rw-rw-r--  1 markl       30814 Oct 31 11:50 pcmailfolder.el
  23. # -rw-rw-r--  1 markl        9542 Oct 30 16:01 pcmaillist.el
  24. #
  25. echo 'x - pcmailedit.el'
  26. if test -f pcmailedit.el; then echo 'shar: not overwriting pcmailedit.el'; else
  27. sed 's/^X//' << '________This_Is_The_END________' > pcmailedit.el
  28. X;;;; GNU-EMACS PCMAIL mail reader
  29. X
  30. X;;  Written by Mark L. Lambert
  31. X;;  Architecture Group, Network Products Division
  32. X;;  Oracle Corporation
  33. X;;  20 Davis Dr,
  34. X;;  Belmont CA, 94002
  35. X;;
  36. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  37. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  38. X
  39. X;; Copyright (C) 1989 Mark L. Lambert
  40. X
  41. X;; This file is not officially part of GNU Emacs, but is being
  42. X;; donated to the Free Software Foundation.  As such, it is
  43. X;; subject to the standard GNU-Emacs General Public License,
  44. X;; referred to below.
  45. X
  46. X;; GNU Emacs is distributed in the hope that it will be useful,
  47. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  48. X;; accepts responsibility to anyone for the consequences of using it
  49. X;; or for whether it serves any particular purpose or works at all,
  50. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  51. X;; License for full details.
  52. X
  53. X;; Everyone is granted permission to copy, modify and redistribute
  54. X;; GNU Emacs, but only under the conditions described in the
  55. X;; GNU Emacs General Public License.   A copy of this license is
  56. X;; supposed to have been given to you along with GNU Emacs so you
  57. X;; can know your rights and responsibilities.  It should be in a
  58. X;; file named COPYING.  Among other things, the copyright notice
  59. X;; and this notice must be preserved on all copies.
  60. X
  61. X;;; edit a mail message.  Substantially similar to rmailedit.el
  62. X
  63. X(defvar pcmail-edit-mode-map nil)
  64. X(if pcmail-edit-mode-map
  65. X    nil
  66. X  (setq pcmail-edit-mode-map (copy-keymap text-mode-map))
  67. X  (define-key pcmail-edit-mode-map "\C-c\C-c" 'pcmail-cease-edit)
  68. X  (define-key pcmail-edit-mode-map "\C-c\C-]" 'pcmail-abort-edit))
  69. X
  70. X(defun pcmail-edit-mode ()
  71. X  "Pcmail Edit Mode is used when editing Pcmail messages.
  72. XPcmail Edit mode is identical to text mode with the addition of two commands:
  73. X\\[pcmail-cease-edit], which saves an edit, and 
  74. X\\[pcmail-abort-edit], which aborts an edit."
  75. X  (put 'pcmail-edit-mode 'mode-class 'special)
  76. X  (use-local-map pcmail-edit-mode-map)
  77. X  (setq major-mode 'pcmail-edit-mode
  78. X    mode-name "Edit")
  79. X  (make-local-variable 'pcmail-old-text)
  80. X  (run-hooks 'pcmail-edit-mode-hook))
  81. X
  82. X(defun pcmail-edit-message ()
  83. X  "Edit the contents of the current message.
  84. XArgs: none
  85. X  Allow the body of the current message to be edited.  On save, changes
  86. Xare made permanent.  On abort, old body is restored. Type
  87. X\\[pcmail-cease-edit\\] to make changes permanent, \\[pcmail-abort-edit\\] to 
  88. Xabort changes."
  89. X  (interactive)
  90. X  (pcmail-barf-if-empty-folder)
  91. X  (pcmail-edit-mode)
  92. X
  93. X  ;; keep header out of edit region -- stupid lusers could screw it up
  94. X  (goto-char (point-min))
  95. X  (and (search-forward pcmail-header-delim nil t)
  96. X       (narrow-to-region (point) (point-max)))
  97. X  (setq pcmail-old-text (buffer-substring (point-min) (point-max)))
  98. X  (setq buffer-read-only nil)
  99. X  (pcmail-update-folder-mode-line pcmail-current-subset-message)
  100. X  (message (substitute-command-keys
  101. X        (concat "Message edit: Type \\[pcmail-cease-edit] "
  102. X            "to save changes, \\[pcmail-abort-edit] to abort"))))
  103. X
  104. X(defun pcmail-cease-edit ()
  105. X  "Make changes to current message permanent.  Switch back to pcmail keymap.
  106. XArgs: none"
  107. X  (interactive)
  108. X  (unwind-protect
  109. X      (cond ((and (= (length pcmail-old-text) (- (point-max) (point-min)))
  110. X          (string= pcmail-old-text
  111. X               (buffer-substring (point-min) (point-max))))
  112. X         (message "Edit complete; no changes"))
  113. X        (t
  114. X         (pcmail-set-attribute 
  115. X          (pcmail-make-absolute pcmail-current-subset-message) "edited" t)
  116. X         (message "Edit complete.")))
  117. X
  118. X    ;; note -- cannot call pcmail-folder-mode because it gronks all local
  119. X    ;; variables.  That would be Bad.
  120. X    (use-local-map pcmail-folder-mode-map)
  121. X    (setq major-mode 'pcmail-folder-mode
  122. X      mode-name "Folder")
  123. X    (pcmail-goto-message pcmail-current-subset-message)
  124. X    (setq buffer-read-only t)))
  125. X
  126. X(defun pcmail-abort-edit ()
  127. X  "Abort edit of current message; restore original message body.
  128. XArgs: none"
  129. X  (interactive)
  130. X  (delete-region (point-min) (point-max))
  131. X  (insert pcmail-old-text)
  132. X  (pcmail-cease-edit))
  133. X  
  134. X(provide 'pcmailedit)
  135. ________This_Is_The_END________
  136. if test `wc -c < pcmailedit.el` -ne 4075; then
  137.     echo 'shar: pcmailedit.el was damaged during transit (should have been 4075 bytes)'
  138. fi
  139. fi        ; : end of overwriting check
  140. echo 'x - pcmailfolder.el'
  141. if test -f pcmailfolder.el; then echo 'shar: not overwriting pcmailfolder.el'; else
  142. sed 's/^X//' << '________This_Is_The_END________' > pcmailfolder.el
  143. X;;;; GNU-EMACS PCMAIL mail reader
  144. X
  145. X;;  Written by Mark L. Lambert
  146. X;;  Architecture Group, Network Products Division
  147. X;;  Oracle Corporation
  148. X;;  20 Davis Dr,
  149. X;;  Belmont CA, 94002
  150. X;;
  151. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  152. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  153. X
  154. X;; Copyright (C) 1989 Mark L. Lambert
  155. X
  156. X;; This file is not officially part of GNU Emacs, but is being
  157. X;; donated to the Free Software Foundation.  As such, it is
  158. X;; subject to the standard GNU-Emacs General Public License,
  159. X;; referred to below.
  160. X
  161. X;; GNU Emacs is distributed in the hope that it will be useful,
  162. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  163. X;; accepts responsibility to anyone for the consequences of using it
  164. X;; or for whether it serves any particular purpose or works at all,
  165. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  166. X;; License for full details.
  167. X
  168. X;; Everyone is granted permission to copy, modify and redistribute
  169. X;; GNU Emacs, but only under the conditions described in the
  170. X;; GNU Emacs General Public License.   A copy of this license is
  171. X;; supposed to have been given to you along with GNU Emacs so you
  172. X;; can know your rights and responsibilities.  It should be in a
  173. X;; file named COPYING.  Among other things, the copyright notice
  174. X;; and this notice must be preserved on all copies.
  175. X
  176. X;;;; folder commands and utilities
  177. X
  178. X;;;; global variables
  179. X
  180. X;;; system-defined globals
  181. X
  182. X(defconst pcmail-folder-regexp
  183. X  (get 'pcmail-mail-environment 'legal-folder-regexp)
  184. X  "Regexp describing a legal folder name.")
  185. X
  186. X(defconst pcmail-folder-line-regexp
  187. X  (concat "Folder[ \t]+\\(" pcmail-folder-regexp "\\):[ \t]*\\([0-9]+\\)")
  188. X  "Regexp that finds a folder entry in the folder list buffer and binds its
  189. Xname to \\1 and its message count to \\2.")
  190. X
  191. X(defvar pcmail-folder-mode-map nil
  192. X  "Key map for pcmail mode.")
  193. X
  194. X;;; defaults
  195. X
  196. X(defvar pcmail-last-folder nil
  197. X  "The last folder name given to a folder command.")
  198. X
  199. X;;;; folder mode definition
  200. X
  201. X(if pcmail-folder-mode-map
  202. X    nil
  203. X  (suppress-keymap (setq pcmail-folder-mode-map (make-keymap)))
  204. X  (define-key pcmail-folder-mode-map "?" 'describe-mode)
  205. X  (define-key pcmail-folder-mode-map "." 'pcmail-beginning-of-message)
  206. X  (define-key pcmail-folder-mode-map " " 'scroll-up)
  207. X  (define-key pcmail-folder-mode-map ">" 'pcmail-last-message)
  208. X  (define-key pcmail-folder-mode-map "<" 'pcmail-goto-message)
  209. X  (define-key pcmail-folder-mode-map "a" 'pcmail-archive-message)
  210. X  (define-key pcmail-folder-mode-map "b" 'pcmail-sort-folder)
  211. X  (define-key pcmail-folder-mode-map "c" 'pcmail-copy-message)
  212. X  (define-key pcmail-folder-mode-map "d" 'pcmail-delete-message)
  213. X  (define-key pcmail-folder-mode-map "e" 'pcmail-expunge-folder)
  214. X  (define-key pcmail-folder-mode-map "f" 'pcmail-forward-message)
  215. X  (define-key pcmail-folder-mode-map "g" 'pcmail-get-mail)
  216. X  (define-key pcmail-folder-mode-map "h" 'pcmail-summarize-folder)
  217. X  (define-key pcmail-folder-mode-map "i" 'pcmail-change-message-priority)
  218. X  (define-key pcmail-folder-mode-map "j" 'pcmail-goto-message)
  219. X  (define-key pcmail-folder-mode-map "k" 'pcmail-kill-message-later)
  220. X  (define-key pcmail-folder-mode-map "l" 'pcmail-load-mail-drop)
  221. X  (define-key pcmail-folder-mode-map "m" 'pcmail-mail)
  222. X  (define-key pcmail-folder-mode-map "n" 'pcmail-next-message)
  223. X  (define-key pcmail-folder-mode-map "o" 'pcmail-print-message)
  224. X  (define-key pcmail-folder-mode-map "p" 'pcmail-previous-message)
  225. X  (define-key pcmail-folder-mode-map "q" 'pcmail-quit)
  226. X  (define-key pcmail-folder-mode-map "r" 'pcmail-answer-message)
  227. X  (define-key pcmail-folder-mode-map "s" 'pcmail-save-folder)
  228. X  (define-key pcmail-folder-mode-map "t" 'pcmail-toggle-message-header)
  229. X  (define-key pcmail-folder-mode-map "u" 'pcmail-undelete-previous-message)
  230. X  (define-key pcmail-folder-mode-map "v" 'pcmail-version-information)
  231. X  (define-key pcmail-folder-mode-map "w" 'pcmail-edit-message)
  232. X  (define-key pcmail-folder-mode-map "x" 'pcmail-expand-subset)
  233. X  (define-key pcmail-folder-mode-map "y" 'pcmail-change-message-attr)
  234. X  (define-key pcmail-folder-mode-map "z" 'pcmail-zap-to-message)
  235. X  (define-key pcmail-folder-mode-map "\C-d" 'pcmail-delete-message-backward)
  236. X  (define-key pcmail-folder-mode-map "\C-m" 'pcmail-next-message)
  237. X  (define-key pcmail-folder-mode-map "\C-xm" 'pcmail-mail)
  238. X  (define-key pcmail-folder-mode-map "\177" 'scroll-down)
  239. X  (define-key pcmail-folder-mode-map "\ec" 'pcmail-create-folder)
  240. X  (define-key pcmail-folder-mode-map "\ed" 'pcmail-delete-folder)
  241. X  (define-key pcmail-folder-mode-map "\em" 'pcmail-folder-list-folders)
  242. X  (define-key pcmail-folder-mode-map "\en" 'pcmail-next-message-of-type)
  243. X  (define-key pcmail-folder-mode-map "\ep" 'pcmail-previous-message-of-type)
  244. X  (define-key pcmail-folder-mode-map "\er" 'pcmail-rename-folder)
  245. X  (define-key pcmail-folder-mode-map "\e\C-a" 'pcmail-archive-subset)
  246. X  (define-key pcmail-folder-mode-map "\e\C-c" 'pcmail-copy-subset)
  247. X  (define-key pcmail-folder-mode-map "\e\C-d" 'pcmail-delete-subset)
  248. X  (define-key pcmail-folder-mode-map "\e\C-f" 'pcmail-filter-folder)
  249. X  (define-key pcmail-folder-mode-map "\e\C-i" 'pcmail-change-priority-subset)
  250. X  (define-key pcmail-folder-mode-map "\e\C-n" 'pcmail-get-next-folder-mail)
  251. X  (define-key pcmail-folder-mode-map "\e\C-o" 'pcmail-print-subset)
  252. X  (define-key pcmail-folder-mode-map "\e\C-u" 'pcmail-undelete-subset)
  253. X  (define-key pcmail-folder-mode-map "\e\C-y" 'pcmail-change-attr-subset))
  254. X
  255. X;;; pcmail-folder mode -- used in folders
  256. X
  257. X(defun pcmail-folder-mode ()
  258. X  "Pcmail Folder Mode is used by \\[pcmail] for examining mail messages.
  259. XThe following commands are available:
  260. X
  261. X\\{pcmail-folder-mode-map}"
  262. X  (pcmail-mode-setup 'pcmail-folder-mode "Folder" pcmail-folder-mode-map)
  263. X  (pcmail-make-folder-local-variables)
  264. X  (setq mode-line-format
  265. X    (list "" 'pcmail-display-info " " 'global-mode-string))
  266. X  (run-hooks 'pcmail-folder-mode-hook))
  267. X
  268. X(defun pcmail-make-folder-local-variables ()
  269. X  "Create and initialize per-folder local variables.
  270. XArgs: none."
  271. X  (make-local-variable 'pcmail-total-messages)
  272. X  (make-local-variable 'pcmail-current-subset-message)
  273. X  (make-local-variable 'pcmail-message-vector)
  274. X  (make-local-variable 'pcmail-current-subset-vector)
  275. X  (make-local-variable 'pcmail-attr-vector)
  276. X  (make-local-variable 'pcmail-summary-vector)
  277. X  (make-local-variable 'pcmail-date-vector)
  278. X  (make-local-variable 'pcmail-priority-vector)
  279. X  (make-local-variable 'pcmail-current-filter-description)
  280. X  (make-local-variable 'pcmail-display-info)
  281. X  (make-local-variable 'pcmail-summary-buffer)
  282. X  (make-local-variable 'pcmail-folder-name)
  283. X  (setq pcmail-total-messages nil
  284. X    pcmail-current-subset-message nil
  285. X    pcmail-message-vector nil
  286. X    pcmail-current-subset-vector nil
  287. X    pcmail-attr-vector nil
  288. X    pcmail-summary-vector nil
  289. X    pcmail-date-vector nil
  290. X    pcmail-priority-vector nil
  291. X    pcmail-current-filter-description t
  292. X    pcmail-display-info nil
  293. X    pcmail-summary-buffer nil
  294. X    pcmail-folder-name nil))
  295. X
  296. X;;;; folder operations and associated utility routines
  297. X
  298. X(defun pcmail-create-folder (folder-name &optional mail-drop-list)
  299. X  "Create a new folder and maybe attach a mail drop to it.
  300. XArgs: (folder-name &optional mail-drop-list)
  301. X  If called as a function, supply a folder name and an optional list of
  302. Xmail drop symbols; if called interactively, read the folder name from the 
  303. Xminibuffer and read a single mail drop symbol if a prefix argument was 
  304. Xsupplied, turning the symbol into a list of length 1 containing the symbol.
  305. XThe folder created will have a mail: field containing the mail drop symbol
  306. Xor symbols; mail will be transferred from these mail drops when the
  307. X\\[pcmail-get-mail] command is issued."
  308. X  (interactive
  309. X   (list (pcmail-read-folder "Create folder named: ")
  310. X     (and current-prefix-arg
  311. X          (list (intern-soft 
  312. X             (pcmail-completing-read "Attach mail drop of type: "
  313. X                         obarray pcmail-last-mail-drop-type
  314. X                         '(lambda (s)
  315. X                        (get s 'insert-function))
  316. X                         t))))))
  317. X  (and (pcmail-find-folder folder-name)
  318. X       (error "A folder named %s already exists." folder-name))
  319. X  (message "Creating %s..." folder-name)
  320. X  (pcmail-insert-into-folder-list folder-name 0)
  321. X  (pcmail-create-folder-file folder-name mail-drop-list)
  322. X  (message "Creating %s...done" folder-name))
  323. X
  324. X(defun pcmail-delete-folder (&optional folder-name)
  325. X  "Delete a specified folder.
  326. XArgs: (folder-name)
  327. X  If called interactively with a prefix argument, read a folder name from 
  328. Xthe minibuffer and delete that folder, otherwise delete the current folder.
  329. XIf called as a function, supply a folder name or NIL to delete the current 
  330. Xfolder.  Delete FOLDER-NAME, provided it is not pcmail-primary-folder-name.
  331. XDelete the folder file, remove its entry in the folder info list, remove 
  332. Xits line in the folder list file, kill its message buffer, and kill its 
  333. Xsummary buffer.  If FOLDER-NAME has an attached mail drop, get that
  334. Xmail drop's folder-delete-hook property and run the hook."
  335. X  (interactive 
  336. X   (list (and current-prefix-arg (pcmail-read-folder "Delete folder: "))))
  337. X  (or folder-name
  338. X      (setq folder-name pcmail-folder-name))
  339. X  (and (string= folder-name pcmail-primary-folder-name)
  340. X       (error "You may not delete your primary folder."))
  341. X  (or (pcmail-find-folder folder-name)
  342. X      (error "No folder named %s." folder-name))
  343. X  (or (yes-or-no-p "Deletion is permanent; are you sure? ")
  344. X      (error "Delete aborted."))
  345. X  (message "Deleting %s..." folder-name)
  346. X  (pcmail-open-folder folder-name)
  347. X  (let ((droplist (pcmail-get-mail-drop-list folder-name))
  348. X    (drop-delete))
  349. X    (and droplist
  350. X     (while droplist
  351. X       (and (setq drop-delete (get (car droplist) 'folder-delete-hook))
  352. X        (funcall drop-delete folder-name))
  353. X       (setq droplist (cdr droplist)))))
  354. X  (pcmail-remove-from-folder-list folder-name)
  355. X  (pcmail-delete-folder-file folder-name)
  356. X  (message "Deleting %s...done" folder-name))
  357. X
  358. X(defun pcmail-rename-folder (from to)
  359. X  "Change the name of the current folder.  
  360. XArgs: (from to)
  361. X  Rename buffer, folder file, and summary buffer.  Update folder list buffer
  362. Xto reflect new name.  If called interactively, request new name.  With prefix
  363. Xargument, request name of folder to rename, otherwise rename current folder.
  364. XIf called as a function, supply folder to be renamed, NIL for current
  365. Xfolder, together with its new name.  You may not rename 
  366. Xpcmail-primary-folder-name"
  367. X  (interactive 
  368. X   (list (and current-prefix-arg (pcmail-read-folder "Rename folder: "))
  369. X     (pcmail-read-folder "Rename to new name: ")))
  370. X  (or from
  371. X      (setq from pcmail-folder-name))
  372. X  (and (string= from pcmail-primary-folder-name)
  373. X       (error "You may not rename your primary folder."))
  374. X  (or (pcmail-find-folder from)
  375. X      (error "No folder named %s." from))
  376. X  (and (pcmail-find-folder to)
  377. X       (error "A folder named %s already exists." to))
  378. X  (message "Renaming %s to %s..." from to)
  379. X  (save-excursion
  380. X    (pcmail-open-folder from)
  381. X    ; make target buffer, write new file to disk, delete old, rename buffer
  382. X    (let ((tobuf to))
  383. X      (and (get-buffer tobuf)
  384. X       (let ((count 1))
  385. X         (while (get-buffer (setq tobuf (format "%s<%d>" to count)))
  386. X           (setq count (1+ count)))))
  387. X      (write-file (pcmail-folder-file-name to))
  388. X      (condition-case nil
  389. X      (delete-file (pcmail-folder-file-name from))
  390. X    (file-error nil))
  391. X      (setq pcmail-folder-name to)
  392. X      (pcmail-add-folder-entry to (pcmail-nmessages from) tobuf
  393. X                 (pcmail-mail-drop-list from))
  394. X      (pcmail-remove-folder-entry from)
  395. X      (pcmail-update-folder-mode-line pcmail-current-subset-message))
  396. X    ; generate target summary buffer and rename to it
  397. X    (and pcmail-summary-buffer
  398. X     (buffer-name pcmail-summary-buffer)
  399. X     (let ((tobuf (concat to "-summary"))
  400. X           (owner-name pcmail-folder-name))
  401. X       (and (get-buffer tobuf)
  402. X        (let ((count 1))
  403. X          (while (get-buffer (setq tobuf (format "%s<%d>" to count)))
  404. X            (setq count (1+ count)))))
  405. X       (save-excursion
  406. X         (set-buffer pcmail-summary-buffer)
  407. X         (rename-buffer tobuf)
  408. X         (setq pcmail-summary-owner to)
  409. X         (pcmail-set-summary-mode-line-format owner-name))
  410. X       (setq pcmail-summary-buffer (get-buffer tobuf))))
  411. X    ; update folder list buffer
  412. X    (pcmail-insert-into-folder-list to (pcmail-nmessages to))
  413. X    (pcmail-remove-from-folder-list from))
  414. X  (message "Renaming %s to %s...done" from to))
  415. X
  416. X(defun pcmail-save-folder (&optional folder)
  417. X  "Save a folder buffer to disk.
  418. XArgs: (&optional folder)
  419. X  If called interactively, a prefix argument means ask for the name of a 
  420. Xfolder to save, otherwise save the current folder.  If called as a function,
  421. Xsupply the name of the folder to save, or NIL to save the current folder.  
  422. XIf pcmail-expunge-on-save is non-nil, expunge the folder before saving."
  423. X  (interactive 
  424. X   (list (and current-prefix-arg (pcmail-read-folder "Save folder: "))))
  425. X  (or folder
  426. X      (setq folder pcmail-folder-name))
  427. X  (or (pcmail-find-folder folder)
  428. X      (error "No folder named %s." folder))
  429. X  (and pcmail-expunge-on-save
  430. X       (pcmail-expunge-folder folder))
  431. X  (message "Saving %s..." folder)
  432. X  (pcmail-open-folder folder)
  433. X  (pcmail-save-buffer)
  434. X  (message "Saving %s...done" folder))
  435. X
  436. X(defun pcmail-expunge-folder (&optional folder)
  437. X  "Expunge all deleted messages in a specified folder.
  438. XArgs: (&optional folder)
  439. X  If called interactively, a prefix argument means ask for the name of a 
  440. Xfolder to expunge, otherwise expunge the current folder.  If called as 
  441. Xa function, supply the name of the folder to expunge, or NIL to expunge 
  442. Xthe current folder."
  443. X  (interactive 
  444. X   (list (and current-prefix-arg (pcmail-read-folder "Expunge folder: "))))
  445. X  (or folder
  446. X      (setq folder pcmail-folder-name))
  447. X  (or (pcmail-find-folder folder)
  448. X      (error "No folder named %s." folder))
  449. X  (message "Expunging %s..." folder)
  450. X  (pcmail-open-folder folder)
  451. X  (let* ((current-message 1)
  452. X     (new-messages (list (aref pcmail-message-vector 0)))
  453. X     (new-summary (list nil))
  454. X     (new-date (list nil))
  455. X     (new-priority (list nil))
  456. X     (new-subset-map (make-vector (1+ pcmail-total-messages) 0))
  457. X     (new-attr (list nil))
  458. X     (new-current pcmail-current-subset-message)
  459. X     (ndeleted-messages 0)
  460. X     (buffer-read-only nil))
  461. X    (unwind-protect
  462. X    (save-restriction
  463. X      (widen)
  464. X      (goto-char (point-min))
  465. X      (pcmail-expunge-loop)
  466. X      (setq pcmail-total-messages 
  467. X        (- pcmail-total-messages ndeleted-messages)
  468. X        pcmail-message-vector 
  469. X        (apply 'vector 
  470. X               (nreverse
  471. X            (cons (aref pcmail-message-vector current-message)
  472. X                  new-messages)))
  473. X        pcmail-attr-vector (apply 'vector (nreverse new-attr))
  474. X        pcmail-summary-vector (apply 'vector (nreverse new-summary))
  475. X        pcmail-date-vector (apply 'vector (nreverse new-date))
  476. X        pcmail-priority-vector (apply 'vector (nreverse new-priority)))
  477. X      (pcmail-fix-expunged-subset new-subset-map)
  478. X      (pcmail-fix-current-message new-subset-map)
  479. X      (pcmail-set-nmessages folder pcmail-total-messages)
  480. X      (pcmail-change-in-folder-list folder pcmail-total-messages))
  481. X      (or (zerop ndeleted-messages)
  482. X      (pcmail-maybe-resummarize-folder))
  483. X      (pcmail-goto-message pcmail-current-subset-message)))
  484. X  (message "Expunging %s...done (%d message%s)" folder pcmail-total-messages
  485. X       (pcmail-s-ending pcmail-total-messages)))
  486. X
  487. X(defun pcmail-expunge-loop ()
  488. X  "Scan folder, erasing deleted messages.
  489. XArgs: none
  490. X  Iterate through messages in current folder, erasing those with their
  491. Xdeleted attribute set.  Modify inherited variables current-message, 
  492. Xndeleted-messages, new-subset-map, new-messages, new-summary, new-date,
  493. Xnew-priority and new-attr.  Reset message counters on quit signal."
  494. X  (condition-case nil
  495. X      (while (<= current-message pcmail-total-messages)
  496. X    (cond ((pcmail-has-attribute-p current-message "deleted")
  497. X           (and pcmail-wastebasket-on-expunge
  498. X            (pcmail-wastebasket-message current-message 1))
  499. X           (delete-region
  500. X         (marker-position (aref pcmail-message-vector current-message))
  501. X         (marker-position (aref pcmail-message-vector 
  502. X                    (1+ current-message))))
  503. X           (move-marker (aref pcmail-message-vector current-message) nil)
  504. X           (setq ndeleted-messages (1+ ndeleted-messages))
  505. X           (aset new-subset-map current-message nil))
  506. X          (t
  507. X        (aset new-subset-map current-message
  508. X              (- current-message ndeleted-messages))
  509. X        (setq new-messages 
  510. X              (cons (aref pcmail-message-vector current-message) 
  511. X                new-messages)
  512. X              new-summary 
  513. X              (cons (aref pcmail-summary-vector current-message) 
  514. X                new-summary)
  515. X              new-date
  516. X              (cons (aref pcmail-date-vector current-message) 
  517. X                new-date)
  518. X              new-priority
  519. X              (cons (aref pcmail-priority-vector current-message) 
  520. X                new-priority)
  521. X              new-attr 
  522. X              (cons (aref pcmail-attr-vector current-message) 
  523. X                new-attr))))
  524. X    (and (zerop (% (setq current-message (1+ current-message)) 
  525. X               pcmail-progress-interval))
  526. X         (message "Expunging %s...%d" folder current-message)))
  527. X    (quit
  528. X      (pcmail-set-message-vectors))))
  529. X
  530. X(defun pcmail-fix-current-message (map)
  531. X  "Adjusts the current subset message number after expunging a folder.
  532. XArgs: (map)
  533. X  MAP is a vector pcmail-total-messages long, with entries that are either
  534. Xa message's post-expunge message number, or NIL if the message was expunged.
  535. XThis function decrements pcmail-current-subset-message by the number of
  536. XNIL entries in slots numbered less than pcmail-current-subset-message."
  537. X  (cond ((zerop (pcmail-current-subset-length))
  538. X     (setq pcmail-current-subset-message 0))
  539. X    (t
  540. X     (let ((i 0) (count 0))
  541. X       (while (<= i pcmail-current-subset-message)
  542. X         (or (aref map i) (setq count (1+ count)))
  543. X         (setq i (1+ i)))
  544. X       (setq pcmail-current-subset-message
  545. X         (max (- pcmail-current-subset-message count) 1))))))
  546. X
  547. X(defun pcmail-get-mail (&optional folder)
  548. X  "Open FOLDER and display its current message.  
  549. XArgs: (&optional folder)
  550. X  If called interactively, a prefix argument means ask for the name of a 
  551. Xfolder to open, otherwise open the current folder.  If called as a function,
  552. Xsupply the name of the folder to open, or NIL to open the current folder.  
  553. XIf FOLDER has an attached mail drop, read mail from the mail drop and
  554. Xappend it to FOLDER.  If FOLDER is already open and there us no new mail, 
  555. Xdon't change the current message.  If FOLDER is being opened for the first
  556. Xtime now, then after new mail has been read, go to either the last message
  557. Xor the first unseen and interesting message, whatever is first."
  558. X  (interactive
  559. X    (list (if current-prefix-arg (pcmail-read-folder "Open folder: "))))
  560. X  (or folder
  561. X      (setq folder pcmail-folder-name))
  562. X  (or (pcmail-find-folder folder)
  563. X      (error "No folder named %s." folder))
  564. X  (let ((was-openp (pcmail-open-folder folder))
  565. X    (newmsgs 0))
  566. X    (unwind-protect
  567. X    (let ((dl (pcmail-get-mail-drop-list folder)))
  568. X      (and dl (setq newmsgs (pcmail-read-mail-drop folder dl))))
  569. X      (if (and was-openp (zerop newmsgs))
  570. X      (pcmail-goto-message pcmail-current-subset-message)
  571. X    (let ((first (pcmail-next-subset-message-of-type 
  572. X              'forward nil t
  573. X              '(lambda (n)
  574. X             (and (pcmail-interesting-p n)
  575. X                  (pcmail-has-attribute-p n "unseen"))))))
  576. X      (if first
  577. X          (pcmail-goto-message first)
  578. X        (pcmail-last-message)))
  579. X    (pcmail-maybe-resummarize-folder)))))
  580. X
  581. X(defun pcmail-load-mail-drop (mail-drop-sym)
  582. X  "Load a file with a particular mail drop format into the current folder.
  583. XArgs: (mail-drop-sym)
  584. XIf called interactively, read the mail drop type symbol from the minibuffer.  
  585. XCompletion on mail drop symbol is permitted and defaults to last mail 
  586. Xdrop symbol supplied to this command."
  587. X  (interactive
  588. X   (let ((msym))
  589. X     (setq msym
  590. X       (intern-soft 
  591. X        (setq pcmail-last-mail-drop-type
  592. X          (pcmail-completing-read "Load mail drop of type: "
  593. X                      obarray pcmail-last-mail-drop-type
  594. X                      '(lambda (s) 
  595. X                         (get s 'conversion-function))
  596. X                      t))))
  597. X     (list msym)))
  598. X  (let ((folder pcmail-folder-name) (nmsgs pcmail-total-messages))
  599. X    (or (pcmail-find-folder folder)
  600. X    (error "No folder named %s." folder))
  601. X    (unwind-protect
  602. X    (pcmail-read-mail-drop folder (list mail-drop-sym))
  603. X      (let ((first (pcmail-next-subset-message-of-type 
  604. X            'forward nil nil 
  605. X            '(lambda (n)
  606. X               (and (pcmail-interesting-p n)
  607. X                (pcmail-has-attribute-p n "unseen"))))))
  608. X    (if first
  609. X        (pcmail-goto-message first)
  610. X      (pcmail-last-message)))
  611. X      (or (= nmsgs pcmail-total-messages) ;resummarize if new msgs
  612. X      (pcmail-maybe-resummarize-folder)))))
  613. X
  614. X(defun pcmail-get-next-folder-mail ()
  615. X  "Offer to read new mail for the next folder in the folder list.
  616. XArgs: none
  617. XLook for the first folder after this one with an attached mail drop and offer
  618. Xto read mail from that folder.  Wrap around the folder list if necessary."
  619. X  (interactive)
  620. X  (let ((done) (next-folder-name pcmail-folder-name))
  621. X    (while (not done)
  622. X      (setq next-folder-name (pcmail-next-folder-entry next-folder-name))
  623. X      (cond ((string= next-folder-name pcmail-folder-name)
  624. X         (error "No other folders with mail drops"))
  625. X        ((and
  626. X          (save-excursion
  627. X        (or (pcmail-folder-buffer-name next-folder-name)
  628. X            (pcmail-open-folder next-folder-name))
  629. X        t)
  630. X          (pcmail-get-mail-drop-list next-folder-name)
  631. X          (y-or-n-p (concat "Get mail from folder " next-folder-name
  632. X                "? ")))
  633. X         (and (y-or-n-p "Kill current folder? ") 
  634. X          (kill-buffer (current-buffer)))
  635. X         (pcmail-get-mail next-folder-name)
  636. X         (setq done t))))))
  637. X
  638. X;;; folder utility routines
  639. X
  640. X(defun pcmail-create-folder-file (folder mail-drop-list)
  641. X  "Create a new folder file.
  642. XArgs: (folder mail-drop-list)
  643. X  Create a folder file in pcmail-directory with name FOLDER.  Place a
  644. Xpcmail folder Babyl header in it.  If MAIL-DROP-LIST is non-NIL, put the 
  645. Xprinted representation of each of its elts in the folder header's mail-drop: 
  646. Xfield.  Put the folder name, message count, buffer name, and mail-drop list 
  647. Xin the folder info list.  Leave buffer narrowed to Babyl header."
  648. X  (save-excursion
  649. X    (find-file (pcmail-folder-file-name folder))
  650. X    (pcmail-folder-mode)
  651. X    (let ((buffer-read-only nil))
  652. X      (erase-buffer)
  653. X      (pcmail-insert-babyl-header mail-drop-list))
  654. X    (narrow-to-region (point-min) (1- (point-max)))
  655. X    (pcmail-save-buffer)
  656. X    (setq pcmail-folder-name folder)
  657. X    (pcmail-add-folder-entry folder 0 (buffer-name) mail-drop-list)))
  658. X
  659. X(defun pcmail-delete-folder-file (folder)
  660. X  "Delete a folder buffer, summary (if present), and file.
  661. XArgs: (folder)
  662. X  Delete FOLDER's file, and kill its corresponding folder and summary
  663. Xbuffers if they exist.  Remove FOLDER's name from folder info list."
  664. X  (and (file-exists-p (pcmail-folder-file-name folder))
  665. X       (condition-case nil
  666. X       (delete-file (pcmail-folder-file-name folder))
  667. X     (file-error nil)))
  668. X  (let ((buf (pcmail-folder-buffer-name folder)))
  669. X    (and buf
  670. X     (get-buffer buf)
  671. X     (save-excursion
  672. X       (set-buffer buf)
  673. X       (and pcmail-summary-buffer 
  674. X        (get-buffer pcmail-summary-buffer)
  675. X        (kill-buffer pcmail-summary-buffer))
  676. X       (set-buffer-modified-p nil)
  677. X       (kill-buffer buf))))
  678. X  (pcmail-remove-folder-entry folder))
  679. X
  680. X(defun pcmail-maybe-resummarize-folder ()
  681. X  "If pcmail-resummarize-folder is non-NIL, resummarize the current folder.
  682. XArgs: (none)"
  683. X  (cond ((and pcmail-resummarize-folder-on-change
  684. X          pcmail-summary-buffer)
  685. X     (pcmail-summarize-folder)
  686. X     (pop-to-buffer pcmail-summary-owner))))
  687. X
  688. X(defun pcmail-barf-if-empty-folder ()
  689. X  "Barf if a folder is empty.
  690. XArgs: none
  691. X  Signal an error if the current folder's current subset is zero-length.
  692. XSet message counters first, if necessary."
  693. X  (pcmail-maybe-set-message-vectors)
  694. X  (cond ((zerop pcmail-total-messages)
  695. X     (pcmail-display-subset-message 0)
  696. X     (error "%s is empty!" pcmail-folder-name))
  697. X    ((zerop (pcmail-current-subset-length))
  698. X     (pcmail-display-subset-message 0)
  699. X     (error "Current message subset is empty!"))))
  700. X
  701. X(defun pcmail-read-folder (prompt)
  702. X  "Read a folder name form the minibuffer
  703. XArgs: (prompt)
  704. X  Provide PROMPT, then read a folder name from the minibuffer, completing 
  705. Xoff of folder info list.  If pcmail-last-folder is non-NIL, use it as
  706. Xa default.  Set pcmail-last-folder to input value.  See
  707. Xpcmail-completing-read."
  708. X  (or (pcmail-find-folder pcmail-last-folder)
  709. X      (setq pcmail-last-folder nil))
  710. X  (let ((in))
  711. X    (while (not (pcmail-legal-folder-name-p
  712. X         (setq in (pcmail-completing-read
  713. X               prompt obarray pcmail-last-folder
  714. X               '(lambda (s) (get s 'folder-name)))))))
  715. X    (setq pcmail-last-folder in)))
  716. X
  717. X(defun pcmail-legal-folder-name-p (s)
  718. X  "Is specified string a legal Pcmail folder name?
  719. XArgs: (s)
  720. X  Return t if S is a legal folder name, NIL else.  A legal folder name 
  721. Xsatisfies the regexp pcmail-folder-regexp, which is operating-system
  722. Xdependent."
  723. X  (and (string-match pcmail-folder-regexp s)
  724. X       (= (length (substring s (match-beginning 0) (match-end 0)))
  725. X      (length s))))
  726. X
  727. X(defun pcmail-load-folder-information ()
  728. X  "Open the folder list file and construct information for each folder
  729. XArgs: none
  730. X  Using the folder list file, add information for each folder.  The
  731. Xinformation consists of folder name, buffer name, number of messages,
  732. Xand mail drop list."
  733. X  (let ((mbname))
  734. X    (save-excursion
  735. X      (pcmail-open-folder-list)
  736. X      (goto-char (point-min))
  737. X      (while (re-search-forward pcmail-folder-line-regexp nil t)
  738. X    (setq mbname (buffer-substring (match-beginning 1) (match-end 1)))
  739. X    (cond ((not (pcmail-find-folder mbname))
  740. X           (pcmail-set-folder-name mbname mbname)
  741. X           (pcmail-set-nmessages mbname 
  742. X                     (string-to-int (buffer-substring
  743. X                             (match-beginning 2) 
  744. X                             (match-end 2))))))))
  745. X    (bury-buffer pcmail-folder-list)))
  746. X
  747. X(defun pcmail-add-folder-entry (folder nmsgs buf droplist)
  748. X  "Add a folder entry; give it a name, count, buffer, and drop list.
  749. XArgs: (folder nmsgs buf droplist)"
  750. X  (pcmail-set-folder-name folder folder)
  751. X  (pcmail-set-nmessages folder nmsgs)
  752. X  (pcmail-set-folder-buffer-name folder buf)
  753. X  (pcmail-set-mail-drop-list folder droplist))
  754. X
  755. X(defun pcmail-remove-folder-entry (folder)
  756. X  "Remove a folder entry by setting its name to NIL.
  757. XArgs: (folder)"
  758. X  (pcmail-set-folder-name folder nil))
  759. X
  760. X(defun pcmail-get-mail-drop-list (folder-name)
  761. X  "Get this folder's mail-drop list.  Assume folder is current buffer.
  762. XArgs: folder-name
  763. X  If folder has not yet been opened (i.e. buffer name is nil), read list 
  764. Xfrom mail: field of folder file header, turn it into a lisp list, and return."
  765. X  (cond ((not (pcmail-folder-buffer-name folder-name))
  766. X     (pcmail-get-babyl-mail-drop-list))
  767. X    (t
  768. X     (pcmail-mail-drop-list folder-name))))
  769. X
  770. X(defun pcmail-open-folder (folder-name)
  771. X  "Find specified folder's folder file and place it in pcmail mode.
  772. X  Args: (folder-name)
  773. XFind FOLDER-NAME's folder file.  If it did not exist before finding, 
  774. Xplace it in pcmail mode.  Replace old buffer value in folder info list 
  775. Xwith current buffer name.  Set the folder's message counters if necessary.
  776. XLoad the folder's user-defined attributes into the attribute completion
  777. Xobarray.  Turn folder's mail drops (as specified in the folder's mail-drop:
  778. Xfield) into a list and add to folder entry in info list.  Return T if 
  779. XFOLDER-NAME's folder file was already open, NIL else."
  780. X  (let* ((file-name (pcmail-folder-file-name folder-name))
  781. X     (existed (get-file-buffer file-name)))
  782. X    (or (pcmail-find-folder folder-name)
  783. X    (error "%s is not a Pcmail folder." folder-name))
  784. X    (find-file file-name)
  785. X    (cond ((not existed)
  786. X       (pcmail-folder-mode)
  787. X       (setq pcmail-folder-name folder-name)
  788. X       (pcmail-set-mail-drop-list folder-name
  789. X                      (pcmail-get-mail-drop-list folder-name))
  790. X       (pcmail-set-folder-buffer-name folder-name (buffer-name))
  791. X       (pcmail-load-user-defined-attributes)))
  792. X
  793. X    ;require-final-newline hosed us? Punt trailing whitespace but don't
  794. X    ; change buffer-modified-p
  795. X    (save-excursion                
  796. X      (save-restriction
  797. X    (widen)
  798. X    (goto-char (point-max))
  799. X    (skip-chars-backward " \t\n")
  800. X    (let ((buffer-read-only nil)
  801. X          (modp (buffer-modified-p)))
  802. X      (delete-region (point) (point-max))
  803. X      (set-buffer-modified-p modp))))
  804. X    (pcmail-maybe-set-message-vectors)
  805. X    existed))
  806. X
  807. X(defun pcmail-folder-file-name (folder-name)
  808. X  "Expand FOLDER-NAME into an absolute path, translating it as necessary
  809. Xif it contains characters that are illegal file name characters."
  810. X  (expand-file-name (funcall (get 'pcmail-mail-environment
  811. X                  'folder-to-file-function) folder-name)
  812. X            pcmail-directory))
  813. X
  814. X;;; the following functions are the only ones which know about the storage 
  815. X;;; and access method for folder information.  Current method is a folder 
  816. X;;; symbol for each folder, with properties containing number of messages, 
  817. X;;; buffer name, and mail drop list
  818. X  
  819. X(defun pcmail-all-folders (&optional fun)
  820. X  "Return a list of all valid folder names.
  821. XArgs: &optional fun
  822. XIf FUN is present, use it as the completion filter, otherwise use a filter
  823. Xthat will return all folder names"
  824. X  (all-completions "" obarray (or fun '(lambda (s) (get s 'folder-name)))))
  825. X
  826. X(defun pcmail-find-folder (folder-name)
  827. X  "Return non-NIL if specified folder exists, NIL else.
  828. XArgs: (folder-name)
  829. X  Search folder info list for an entry associated with FOLDER-NAME,
  830. Xreturning the entry if it exists, NIL else."
  831. X  (and (stringp folder-name)
  832. X       (setq folder-name (intern-soft folder-name))
  833. X       (get folder-name 'folder-name)
  834. X       folder-name))
  835. X
  836. X(defun pcmail-set-folder-name (folder-name name)
  837. X  "Set FOLDER-NAME's symbol's 'folder-name property to NAME
  838. XArgs: (folder-name name).
  839. X  Note that FOLDER-NAME need not be a valid folder name, since the test
  840. Xfor validity will fail until this routine is called to insert a valid name."
  841. X  (put (intern folder-name) 'folder-name name))
  842. X
  843. X(defun pcmail-set-folder-buffer-name (folder-name bname)
  844. X  "Set FOLDER-NAME's symbol's 'folder-buffer-name property to BNAME
  845. XArgs: (folder-name bname)."
  846. X  (put (pcmail-find-folder folder-name) 'folder-buffer-name bname))
  847. X
  848. X(defun pcmail-set-mail-drop-list (folder-name droplist)
  849. X  "Set FOLDER-NAME's symbol's 'mail-drop-list property to DROPLIST
  850. XArgs: (folder-name droplist)."
  851. X  (put (pcmail-find-folder folder-name) 'mail-drop-list droplist))
  852. X
  853. X(defun pcmail-set-nmessages (folder-name nmsgs)
  854. X  "Set FOLDER-NAME's symbol's 'nmessages property to NMSGS
  855. XArgs: (folder-name nmsgs)."
  856. X  (put (pcmail-find-folder folder-name) 'nmessages nmsgs))
  857. X
  858. X(defun pcmail-nmessages (folder-name)
  859. X  "Return the number of messages contained in the specified folder.
  860. XArgs: (folder-name)"
  861. X  (and (setq folder-name (pcmail-find-folder folder-name))
  862. X       (get folder-name 'nmessages)))
  863. X
  864. X(defun pcmail-mail-drop-list (folder-name)
  865. X  "Return the mail drop list attached to the specified folder.
  866. XArgs: (folder-name)"
  867. X  (and (setq folder-name (pcmail-find-folder folder-name))
  868. X       (get folder-name 'mail-drop-list)))
  869. X
  870. X(defun pcmail-folder-buffer-name (folder-name)
  871. X  "Return the buffer name associated with the specified folder.
  872. XArgs: (folder-name)"
  873. X  (and (setq folder-name (pcmail-find-folder folder-name))
  874. X       (get folder-name 'folder-buffer-name)))
  875. X
  876. X(provide 'pcmailfolder)
  877. ________This_Is_The_END________
  878. if test `wc -c < pcmailfolder.el` -ne 30814; then
  879.     echo 'shar: pcmailfolder.el was damaged during transit (should have been 30814 bytes)'
  880. fi
  881. fi        ; : end of overwriting check
  882. echo 'x - pcmaillist.el'
  883. if test -f pcmaillist.el; then echo 'shar: not overwriting pcmaillist.el'; else
  884. sed 's/^X//' << '________This_Is_The_END________' > pcmaillist.el
  885. X;;;; GNU-EMACS PCMAIL mail reader
  886. X
  887. X;;  Written by Mark L. Lambert
  888. X;;  Architecture Group, Network Products Division
  889. X;;  Oracle Corporation
  890. X;;  20 Davis Dr,
  891. X;;  Belmont CA, 94002
  892. X;;
  893. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  894. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  895. X
  896. X;; Copyright (C) 1989 Mark L. Lambert
  897. X
  898. X;; This file is not officially part of GNU Emacs, but is being
  899. X;; donated to the Free Software Foundation.  As such, it is
  900. X;; subject to the standard GNU-Emacs General Public License,
  901. X;; referred to below.
  902. X
  903. X;; GNU Emacs is distributed in the hope that it will be useful,
  904. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  905. X;; accepts responsibility to anyone for the consequences of using it
  906. X;; or for whether it serves any particular purpose or works at all,
  907. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  908. X;; License for full details.
  909. X
  910. X;; Everyone is granted permission to copy, modify and redistribute
  911. X;; GNU Emacs, but only under the conditions described in the
  912. X;; GNU Emacs General Public License.   A copy of this license is
  913. X;; supposed to have been given to you along with GNU Emacs so you
  914. X;; can know your rights and responsibilities.  It should be in a
  915. X;; file named COPYING.  Among other things, the copyright notice
  916. X;; and this notice must be preserved on all copies.
  917. X
  918. X
  919. X;;;; folder list commands and utilities
  920. X
  921. X;;;; global variables
  922. X
  923. X;;; system-defined globals
  924. X
  925. X(defconst pcmail-folder-list "folders"
  926. X  "The file under pcmail-directory that contains the pcmail folder list.")
  927. X
  928. X(defvar pcmail-folder-list-mode-map nil
  929. X  "Key map for pcmail-folder-list mode.")
  930. X
  931. X;;;; key map and definitions
  932. X
  933. X(if pcmail-folder-list-mode-map
  934. X    nil
  935. X  (suppress-keymap (setq pcmail-folder-list-mode-map (make-keymap)))
  936. X  (define-key pcmail-folder-list-mode-map "." 
  937. X    'pcmail-folder-list-beginning-of-message)
  938. X  (define-key pcmail-folder-list-mode-map "?" 'describe-mode)
  939. X  (define-key pcmail-folder-list-mode-map "c" 'pcmail-create-folder)
  940. X  (define-key pcmail-folder-list-mode-map "d" 
  941. X    'pcmail-folder-list-delete-folder)
  942. X  (define-key pcmail-folder-list-mode-map "e" 
  943. X    'pcmail-folder-list-expunge-folder)
  944. X  (define-key pcmail-folder-list-mode-map "g" 'pcmail-folder-list-get-mail)
  945. X  (define-key pcmail-folder-list-mode-map "h" 
  946. X    'pcmail-folder-list-summarize-folder)
  947. X  (define-key pcmail-folder-list-mode-map "i" 'pcmail-folder-list-get-mail)
  948. X  (define-key pcmail-folder-list-mode-map "q" 'pcmail-quit)
  949. X  (define-key pcmail-folder-list-mode-map "r" 
  950. X    'pcmail-folder-list-rename-folder)
  951. X  (define-key pcmail-folder-list-mode-map "s" 'pcmail-folder-list-save-folder)
  952. X  (define-key pcmail-folder-list-mode-map "x" 'pcmail-folder-list-exit))
  953. X
  954. X;;; pcmail-folder-list mode -- used in folder list buffer
  955. X
  956. X(defun pcmail-folder-list-mode () 
  957. X  "Pcmail Folder List Mode is used by \\[pcmail] for manipulating Pcmail
  958. Xfolders.  The following commands are available:
  959. X\\{pcmail-folder-list-mode-map}"
  960. X  (interactive)
  961. X  (pcmail-mode-setup 'pcmail-folder-list-mode "Folder List" 
  962. X             pcmail-folder-list-mode-map)
  963. X  (let ((fill-pre (cond (mode-line-inverse-video "") (t "-----")))
  964. X    (fill-post (cond (mode-line-inverse-video " ") (t "%-"))))
  965. X    (setq mode-line-format (list fill-pre "Folder List            "
  966. X                 'global-mode-string fill-post)))
  967. X  (run-hooks 'pcmail-folder-list-mode-hook))
  968. X
  969. X;;;; folder-list mode commands
  970. X
  971. X(defun pcmail-folder-list-folders ()
  972. X  "Open and display the folder list file in the other window.
  973. XArgs: none"
  974. X  (interactive)
  975. X  (let ((b))
  976. X    (save-excursion
  977. X      (pcmail-open-folder-list)
  978. X      (setq b (current-buffer)))
  979. X    (pop-to-buffer b)
  980. X    (goto-char (point-min))))
  981. X
  982. X(defun pcmail-folder-list-exit ()
  983. X  "Exit the folder list, returning to the current folder.
  984. XArgs: none"
  985. X  (interactive)
  986. X  (pop-to-buffer (or (and (pcmail-folder-buffer-name (pcmail-folder-at-point))
  987. X              (get-buffer (pcmail-folder-buffer-name 
  988. X                       (pcmail-folder-at-point))))
  989. X             (pcmail-folder-buffer-name pcmail-primary-folder-name)))
  990. X  (delete-other-windows))
  991. X
  992. X(defun pcmail-folder-list-beginning-of-message ()
  993. X  "Display the current message in the folder next to the cursor.
  994. XArgs: none"
  995. X  (interactive)
  996. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  997. X    (other-window 1)
  998. X    (pcmail-open-folder mb)
  999. X    (pcmail-beginning-of-message)))
  1000. X
  1001. X(defun pcmail-folder-list-rename-folder ()
  1002. X  "Change the name of the next to the cursor.  See pcmail-rename-folder-1.
  1003. XArgs: none"
  1004. X  (interactive)
  1005. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1006. X    (other-window 1)
  1007. X    (pcmail-rename-folder mb (pcmail-read-folder "Rename to new name: "))))
  1008. X
  1009. X(defun pcmail-folder-list-delete-folder ()
  1010. X  "Delete the folder next to the cursor.  See pcmail-delete-folder.
  1011. XArgs: none"
  1012. X  (interactive)
  1013. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1014. X    (other-window 1)
  1015. X    (pcmail-delete-folder mb)))
  1016. X
  1017. X(defun pcmail-folder-list-save-folder ()
  1018. X  "Save the folder next to the cursor.  See pcmail-save-folder.
  1019. XArgs: none"
  1020. X  (interactive)
  1021. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1022. X    (other-window 1)
  1023. X    (pcmail-save-folder mb)))
  1024. X
  1025. X(defun pcmail-folder-list-summarize-folder ()
  1026. X  "Summarize the folder next to the cursor.  See pcmail-summarize-folder.
  1027. XArgs: none"
  1028. X  (interactive)
  1029. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1030. X    (other-window 1)
  1031. X    (pcmail-summarize-folder mb)))
  1032. X
  1033. X(defun pcmail-folder-list-expunge-folder ()
  1034. X  "Expunge the folder next to the cursor.  See pcmail-expunge-1.
  1035. XArgs: none"
  1036. X  (interactive)
  1037. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1038. X    (other-window 1)
  1039. X    (pcmail-expunge-folder mb)))
  1040. X    
  1041. X(defun pcmail-folder-list-get-mail ()
  1042. X  "Open the folder next to the cursor and transfer any new mail into it.
  1043. XArgs: none
  1044. X  Open the current folder.  If the folder has an attached mail drop list,
  1045. Xtransfer mail from the mail drops into the folder.  See pcmail-get-mail."
  1046. X  (interactive)
  1047. X  (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
  1048. X    (other-window 1)
  1049. X    (pcmail-get-mail mb)))
  1050. X
  1051. X;;; folder list utility routines
  1052. X
  1053. X(defun pcmail-create-folder-list-file ()
  1054. X  "Create a folder list file in the mail directory
  1055. XArgs: none"
  1056. X  (pcmail-open-folder-list)
  1057. X  (set-buffer-modified-p t)
  1058. X  (pcmail-save-buffer))
  1059. X  
  1060. X(defun pcmail-open-folder-list ()
  1061. X  "Find and display the folder list file in pcmail-folder-list mode.
  1062. XArgs: none"
  1063. X  (let ((existed (get-buffer pcmail-folder-list)))
  1064. X    (find-file (expand-file-name pcmail-folder-list pcmail-directory))
  1065. X    (or existed
  1066. X    (pcmail-folder-list-mode))))
  1067. X
  1068. X(defun pcmail-folder-at-point ()
  1069. X  "Return name of folder where cursor is in folder list buffer.
  1070. XArgs: none
  1071. X  Jump to folder list buffer pcmail-folder-list and return the name of the 
  1072. Xfolder on the buffer's current line.  Return NIL if the buffer is empty, 
  1073. Ximproperly formatted, or if no folder exists on the current line."
  1074. X  (and (get-buffer pcmail-folder-list)
  1075. X       (save-excursion
  1076. X     (set-buffer pcmail-folder-list)
  1077. X     (save-excursion
  1078. X       (end-of-line)
  1079. X       (and (re-search-forward pcmail-folder-line-regexp 
  1080. X                   (prog1 (point) (beginning-of-line)) t)
  1081. X        (buffer-substring (match-beginning 1) (match-end 1)))))))
  1082. X
  1083. X(defun pcmail-next-folder-entry (folder-name)
  1084. X  "Return the name of the folder following FOLDER-NAME in the folder list.
  1085. XArgs: (folder-list)"
  1086. X  (let ((nextname))
  1087. X    (and (pcmail-find-folder folder-name)
  1088. X     (save-excursion
  1089. X       (pcmail-open-folder-list)
  1090. X       (goto-char (point-min))
  1091. X       (re-search-forward (concat "^folder " folder-name ":.*\n") nil t)
  1092. X       (and (eq (point) (point-max))    ;wrap if at end of buffer
  1093. X        (goto-char (point-min)))
  1094. X       (setq nextname (pcmail-folder-at-point))))
  1095. X    (bury-buffer pcmail-folder-list)
  1096. X    nextname))
  1097. X    
  1098. X(defun pcmail-change-in-folder-list (folder-name nmessages)
  1099. X  "Update a specified folder's entry in the folder list buffer.
  1100. XArgs: (folder-name nmessages)"
  1101. X  (save-excursion
  1102. X    (pcmail-open-folder-list)
  1103. X    (let ((buffer-read-only nil))
  1104. X      (goto-char (point-min))
  1105. X      (and (re-search-forward (format "Folder %s:.*\n" folder-name) nil t)
  1106. X       (replace-match (format "Folder %s: %d message%s\n" folder-name
  1107. X                  nmessages (pcmail-s-ending nmessages))))))
  1108. X  (bury-buffer pcmail-folder-list)
  1109. X  (pcmail-save-buffer pcmail-folder-list))
  1110. X
  1111. X(defun pcmail-insert-into-folder-list (folder-name nmessages)
  1112. X  "Add a new folder line to the folder list buffer.
  1113. XArgs: (folder-name nmessages)
  1114. X  Open the folder list file, go to the end of the buffer, and append an
  1115. Xentry for FOLDER-NAME with a message count of NMESSAGES.  Save and bury
  1116. Xthe list buffer after insertion."
  1117. X  (save-excursion
  1118. X    (pcmail-open-folder-list)
  1119. X    (let ((buffer-read-only nil))
  1120. X      (goto-char (point-max))
  1121. X      (or (= (buffer-size) 0)        ;add newline if already text in the
  1122. X      (eq (preceding-char) ?\n)    ;buffer with no trailing newline
  1123. X      (insert ?\n))
  1124. X      (insert "Folder " folder-name ": " (int-to-string nmessages)
  1125. X          " message" (pcmail-s-ending nmessages) "\n")))
  1126. X  (bury-buffer pcmail-folder-list))
  1127. X
  1128. X(defun pcmail-remove-from-folder-list (folder-name)
  1129. X  "Remove a specified folder's entry from the folder list buffer.
  1130. XArgs: (folder-name)"
  1131. X  (save-excursion
  1132. X    (pcmail-open-folder-list)
  1133. X    (let ((buffer-read-only nil))
  1134. X      (goto-char (point-min))
  1135. X      (cond ((re-search-forward (format "Folder %s:" folder-name) nil t)
  1136. X         (beginning-of-line)
  1137. X         (delete-region (point) (progn (forward-line 1) (point)))))))
  1138. X  (bury-buffer pcmail-folder-list))
  1139. X
  1140. X(provide 'pcmaillist)
  1141. ________This_Is_The_END________
  1142. if test `wc -c < pcmaillist.el` -ne 9542; then
  1143.     echo 'shar: pcmaillist.el was damaged during transit (should have been 9542 bytes)'
  1144. fi
  1145. fi        ; : end of overwriting check
  1146. exit 0
  1147.  
  1148.